perm filename SUBR1.F4[TCH,LCS] blob sn#166851 filedate 1975-08-10 generic text, type T, neo UTF8
00100	C SUBR1.F4 **** STOPS REP. OF RAND. NOTES AFTER 3" -- AND ACCENTS A-FLAT	
00200	
00300		SUBROUTINE SUBR
00400		COMMON /INS/ INST(27),BG(60)
00500		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00600	C   INUM=INST#  IPAR=PARAM#  
00700	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
00800	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
00900	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
01000	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
01100	C   F1=86  F15=100 (NO F16!)
01200	
01300		DATA L/0/
01400	C  SETS INITIAL VALUE OF L
01500	
01600		IF(P(1).LT.3)RETURN
01700	C DON'T USE THIS ROUTINE UNTIL AFTER TIME 3".
01800	
01900		J=P(3)
02000	C CHANGES RANDOMLY CHOSEN NOTE NUM INTO INTEGER FORM
02100	
02200		IF(J.NE.L)GO TO 2
02300	C  CHECKS TO SEE IF IT'S THE SAME AS PREVIOUS NOTE CHOSEN.
02400	
02500		J=J+1
02600	C IT IS -- SO MAKE IT A 1/2 STEP HIGHER
02700	
02800		IF(J.GT.47)J=44
02900	C IF 1/2 STEP HIGHER WENT ABOVE B-FLAT MOVE IT DOWN TO G.
03000	
03100		P(3)=J
03200	C  PUT IT BACK IN P3
03300	
03400	2	L=J
03500	C  SAVE THE NOTE NUMBER IN L FOR THE NEXT TIME AROUND.
03600	
03700		P(5)=87
03800	C  NOW NOTES ARE STACC. (F2=85+2)
03900	
04000		IF(J.NE.45)RETURN
04100	C  RETURN IF NOT A-FLAT
04150	
04200		P(4)=2000
04300	C  MAKE A-FLAT LOUDER ALWAYS
04350	
04400		P(5)=86
04500	C  ALSO MAKE IT SOST.  (F1=85+1)
04600	
04700		P(3)=J+P(6)
04800	C  A-FLAT WILL SHIFT OCTAVES RANDOMLY ACCORDING TO P6
04900		RETURN
05000		END
05100	
05150	
05200	C  TYPICAL INPUT FOR THIS SUBROUTINE.
05300	
05400	C BRIT 0 6;
05500	C P2 .1;  P3 1  G4,BF;  <NOTE NUMBERS 44 TO 47
05600	C P5  F1; P6 .33 0,0   .33 12,12   .34 -12,-12  SUBN;<ALSO CALLS SUBROUTINE
05700	C P4 500;  P8 F5;  END;